home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
os2
/
adaptor.zip
/
ADAPT.ZIP
/
adaptor
/
src
/
fadapt.c
< prev
next >
Wrap
Text File
|
1994-01-03
|
25KB
|
780 lines
/*************************************************************************
* *
* Name : fadapt.c *
* *
* Purpose : Driver program of the ADAPTOR translation tool *
* *
* Author : Dr. Thomas Brandes, GMD, I1.HR *
* *
* Last Update : June 1993 *
* *
*************************************************************************/
#include <stdio.h>
#include <stdlib.h>
#include "global.h"
#include "Parser.h"
#include "Tree.h"
#include "MakeDefs.h"
#include "Analysi.h"
#include "Temporar.h"
#include "Init.h"
#include "Serial.h"
#include "Transfor.h"
#include "Definiti.h"
#include "Unparse.h"
#include "CallGraF.h" /* for TheCallGraph */
#include "Calling.h"
#include "DataFlow.h"
# ifdef alliant
# include <fcntl.h> /* for testing fileaccess */
# else
# include <unistd.h> /* for testing fileaccess */
# endif
#include <sys/types.h> /* for getpid */
/* external variables defined in this module */
int interactive = 0;
char ** fad_argv; /* used for makefile writer */
int fad_argc; /* used for makefile writer */
#define DEBUG(x)
#define MAXCOMMANDLINELENGTH 1024
#define MAXPATHNAMELENGTH 1024
#define USETMP 2
#define TMP "/tmp/adaptor"
static int usetmp;
static char cat[MAXCOMMANDLINELENGTH];
static char tempfile[MAXCOMMANDLINELENGTH];
/****************************************************************/
/* is_source_file() */
/* INPUT: string */
/* length (length of string) */
/* OUTPUT: true, if string is an allowed fortran filename */
/* false, if string isn`t a fortran filename */
/****************************************************************/
bool is_source_file (string, length)
char *string;
int length;
{
if (strcmp(string+length-2,".f") == 0) return (true);
if (strcmp(string+length-2,".F") == 0) return (true);
if (strcmp(string+length-3,".f9") == 0) return (true);
if (strcmp(string+length-3,".F9") == 0) return (true);
if (strcmp(string+length-4,".fcm") == 0) return (true);
return(false);
}
int SourceParser (fname)
char *fname;
/* parses the fortran file 'fname', returns number
of syntax errors in the source file
-1 : file could not be opened */
{ int Errors;
filename = fname; /* for makefile write, will know the file name */
BeginFile (fname);
BeginPos (fname);
Errors = Parse ();
ClosePos ();
if (Errors == 0)
sprintf (last_message, "Succesful parsed");
else
sprintf (last_message, "Parsing with %d Errors", Errors);
return (Errors);
}
int SourceCheck ()
{ if (!CheckTree (TreeRoot))
{ sprintf (last_message, "Tree is not okay");
return 1;
}
else
{ sprintf (last_message, "Tree is good");
return 0;
}
}
int SourceSemantic ()
{ int phase;
int errors;
printf ("\n");
printf ("SEMANTIC PHASE 1 : Make Definitions\n");
phase = 1;
MakeDefs (TreeRoot);
errors = protocol_errors ();
if (errors > 0)
{ printf (" %d Errors occured, see adaptor.def\n", errors);
sprintf (last_message,
"%d Errors in SEMANTIC 1 : MakeDefs (see adaptor.def)", errors);
goto Ende;
}
printf (" successfully completed\n");
printf ("\n");
printf ("SEMANTIC PHASE 2 : Checking\n");
phase = 2;
BeginSemantic ();
Semantic (TreeRoot);
CloseSemantic ();
errors = protocol_errors ();
if (errors > 0)
{ printf (" %d Errors occured, see adaptor.sem\n", errors);
sprintf (last_message,
"%d Errors in SEMANTIC 2 : Checks (see adaptor.sem)", errors);
goto Ende;
}
printf (" successfully completed\n");
printf ("\n");
printf ("SEMANTIC PHASE 3 : Control Flow\n");
phase = 3;
ControlFlow (TreeRoot);
errors = protocol_errors ();
if (errors > 0)
{ printf (" %d Errors occured, see adaptor.cf\n", errors);
sprintf (last_message,
"%d Errors in SEMANTIC 3 : Control Flow (see adaptor.cf)", errors);
goto Ende;
}
printf (" successfully completed\n");
sprintf (last_message, "Semantic Analysis was successful");
phase = 0;
Ende: return (phase);
}
int SourceWrite ()
{ FILE *myFile;
printf ("Write Tree on File test.out \n");
myFile = fopen ("test.out","w");
if (myFile == (FILE *) NULL)
{ printf ("Adaptor failed to open file test.out\n");
printf ("Please check permissions\n");
exit (-1);
}
WriteTree (myFile, TreeRoot);
fclose (myFile);
printf ("Writing Tree is ready\n");
sprintf (last_message, "Abtract Tree written to file test.out");
}
int SourceCalling ()
{ FILE *myFile;
BeginCalling ();
printf ("Starting Calling Analysis \n");
Calling (TreeRoot);
printf ("Ending Calling Analysis\n");
/* printf ("Write CallGraph on File test.cg \n");
myFile = fopen ("test.cg","w");
if (myFile == (FILE *) NULL)
{ printf ("Adaptor failed to open file test.cg\n");
printf ("Please check permissions\n");
exit (-1);
}
WriteCallGraph (myFile, TheCallGraph);
fclose (myFile);
printf ("Writing CallGraph is ready\n");
CloseCalling ();
*/
/* import CGFile from Calling.h */
printf ("Start Writing CallGraph \n");
CGFile = fopen ("test.cal","w");
if (CGFile == (FILE *) NULL)
{ printf ("Adaptor failed to open file test.cal\n");
printf ("Please check permissions\n");
exit (-1);
}
OutCallGraph (TheCallGraph);
fclose (CGFile);
printf ("End Writing CallGraph to a File\n");
sprintf (last_message, "Call Graph has been generated");
}
int SourceDataFlow ()
{ BeginDataFlow ();
printf ("Starting Data Flow Analysis \n");
DataFlow (TreeRoot);
printf ("Ending Data Flow Analysis\n");
CloseDataFlow ();
printf ("Start Writing Dependences \n");
DepFile = fopen ("test.dp","w");
if (DepFile == (FILE *) NULL)
{ printf ("Adaptor failed to open file test.dp\n");
printf ("Please check permissions\n");
exit (-1);
}
OutDependences (TreeRoot);
fclose (DepFile);
printf ("End Writing Dependences to a File\n");
}
void SourceUnparse ()
{ BeginUnparse ();
Unparse (TreeRoot);
CloseUnparse ();
}
int SourceAdapt ()
{ FILE *f;
tTree HostRoot;
int errors;
int phase;
char node_file [10]; /* name of file for node/cube/node1 program */
/* PHASE 1 : ADAPTOR Analysis */
printf ("\n");
printf ("ADAPTOR PHASE 1 : Analysis\n");
phase = 1;
BeginAdaptAnalysis ();
AdaptAnalysis (TreeRoot);
CloseAdaptAnalysis ();
errors = protocol_errors ();
if (errors > 0)
{ printf (" %d Errors occured, see adaptor.anl\n", errors);
sprintf (last_message,
"%d Errors in PHASE 1 : Analysis (see adaptor.anl)", errors);
goto Ende;
}
printf (" successfully completed\n");
/* PHASE 2 : ADAPTOR Distributions */
printf ("\n");
printf ("ADAPTOR PHASE 2 : Distributions\n");
phase = 2;
BeginAdaptDistributions ();
AdaptDistributions (TreeRoot);
CloseAdaptDistributions ();
errors = protocol_errors ();
if (errors > 0)
{ printf (" %d Errors occured, see adaptor.dis\n", errors);
sprintf (last_message,
"%d Errors in PHASE 2 : Distributions (see adaptor.dis)", errors);
goto Ende;
}
printf (" successfully completed\n");
/* PHASE 3 : ADAPTOR Temporary */
printf ("\n");
printf ("ADAPTOR PHASE 3 : Temporary Variables \n");
phase = 3;
AdaptTemporary (TreeRoot);
errors = protocol_errors ();
if (errors > 0)
{ printf (" %d Errors occured, see adaptor.tmp\n", errors);
sprintf (last_message,
"%d Errors in PHASE 3 : Temporary (see adaptor.tmp)", errors);
goto Ende;
}
if (!CheckTree (TreeRoot))
{ printf ("Tree is not okay after creating temporaries \n");
sprintf (last_message, "Illegal Tree after PHASE 3 : Temporary ");
goto Ende;
}
printf (" successfully completed\n");
/* PHASE 4 : ADAPTOR Initialization */
printf ("\n");
printf ("ADAPTOR PHASE 4 : Initial\n");
phase = 4;
AdaptInit (TreeRoot);
errors = protocol_errors ();
if (errors > 0)
{ printf (" %d Errors occured, see adaptor.ini\n", errors);
sprintf (last_message,
"%d Errors in PHASE 4 : Initial (see adaptor.ini)", errors);
phase = 4;
goto Ende;
}
if (!CheckTree (TreeRoot))
{ printf ("Tree is not okay after initial transformation\n");
sprintf (last_message, "Illegal Tree after PHASE 3 : Initial ");
goto Ende;
}
printf (" successfully completed\n");
/* PHASE 5 : ADAPTOR Serialization */
printf ("\n");
printf ("ADAPTOR PHASE 5 : Serial\n");
phase = 5;
AdaptSerial (TreeRoot);
errors = protocol_errors ();
if (errors > 0)
{ printf (" %d Errors occured, see adaptor.seq\n", errors);
sprintf (last_message,
"%d Errors in PHASE 5 : Serial (see adaptor.seq)", errors);
phase = 5;
goto Ende;
}
if (!CheckTree (TreeRoot))
{ printf ("Tree is not okay after serialization\n");
sprintf (last_message, "Illegal Tree after PHASE 5 : Serial ");
goto Ende;
}
SourceUnparse ();
printf (" successfully completed (see unparse.f)\n");
/* PHASE 6 : ADAPTOR Transformation */
printf ("\n");
printf ("ADAPTOR PHASE 6 : Transform\n");
phase = 6;
if (target_model == HOST_NODE)
{ HostRoot = CopyTree (TreeRoot);
HostAdapt (HostRoot);
errors = protocol_errors ();
if (errors > 0)
{ printf (" %d Errors occured, see adaptor.tra\n", errors);
sprintf (last_message,
"%d Errors in PHASE 5 : Host (see adaptor.tra)", errors);
goto Ende;
}
if (!CheckTree (HostRoot))
{ printf ("Host Tree is not okay\n");
sprintf (last_message,"Illegal Host Tree after PHASE 5 : Transform");
goto Ende;
}
f = fopen ("host.f", "w");
if (f == (FILE *) NULL)
{ printf ("Adaptor failed to open file host.f\n");
printf ("Please check permissions\n");
exit (-1);
}
FileUnparse (f, HostRoot);
fclose (f);
printf (" Host program successfully generated\n");
}
/* define node_file */
if (target_model == HOST_NODE)
sprintf (node_file, "node.f");
else if (target_model == UNI_PROC)
sprintf (node_file, "node1.f");
else /* target_model == ONLY_NODE */
sprintf (node_file, "cube.f");
NodeAdapt (TreeRoot);
errors = protocol_errors ();
if (errors > 0)
{ printf (" %d Errors occured, see adaptor.tra\n", errors);
sprintf (last_message,
"%d Errors in PHASE 6 : Node (see adaptor.tra)", errors);
goto Ende;
}
if (!CheckTree (TreeRoot))
{ printf ("Node Tree is not okay\n");
sprintf (last_message, "Illegal Node Tree after PHASE 5 : Transform");
goto Ende;
}
f = fopen (node_file, "w");
if (f == (FILE *) NULL)
{ printf ("Adaptor failed to open file %s\n", node_file);
printf ("Please check permissions\n");
exit (-1);
}
FileUnparse (f, TreeRoot);
fclose (f);
printf (" Node program (%s) successfully generated\n", node_file);
sprintf (last_message, "Translation successful");
phase = 0;
Ende: return(phase);
}
int command; /* global used */
char *filename;
/****************************************************************
* *
* check_options: *
* *
* INPUT: none *
* OUTPUT: TRUE, if options are ok *
* FALSE, if options are not allowed *
* *
****************************************************************/
bool check_options()
{ char filename [MAXPATHNAMELENGTH];
/* Test 1 : interactive use requires some files */
if (command == 0)
{ if (access (PHOME, R_OK) != 0)
{ fprintf(stderr,"No access on ADAPTOR Home-Directory %s\n", PHOME);
return (false);
}
sprintf (filename, "%s/welcome", PHOME);
if (access (filename,R_OK) != 0)
{ fprintf(stderr,"no access on welcome file %s\n", filename);
return(false);
}
sprintf (filename, "%s/help", PHOME);
if (access (filename,R_OK) != 0)
{ fprintf(stderr,"no access on help file %s\n", filename);
return(false);
}
}
/* Test 2 : do nout use FORTRAN_90 together with STATIC_ARRAYS */
if ((target_language == FORTRAN_90) && (array_kind == STATIC_ARRAYS))
{ sprintf (last_message,
"FORTRAN 90 and STATIC ARRAYS cannot be used together");
fprintf(stderr, "%s\n", last_message);
return(false);
}
if (MinProc < 1)
{ sprintf (last_message, "At least one processor is required");
fprintf(stderr, "%s\n", last_message);
return(false);
}
if (StaticArraySize < 1)
{ sprintf (last_message, "Static array size < 1 does not make sense");
fprintf(stderr, "%s\n", last_message);
return(false);
}
return(true);
}
eval_arg (argc, argv)
int argc;
char **argv;
{ int i;
char *comm;
void print_help ();
void print_defaults ();
command = 0;
target_machine = predefined_target_machine;
target_language = predefined_target_language;
target_model = predefined_target_model;
array_kind = predefined_array_kind;
ddefault_kind = predefined_ddefault_kind;
MinProc = predefined_MinProc;
StaticArraySize = predefined_StaticArraySize;
split_flag = predefined_split_flag;
strcpy (PHOME, predefined_PHOME);
/* PHOME can be replaced with value of environment variable */
if (getenv(PHOME_envvar))
strcpy(PHOME,getenv(PHOME_envvar));
fad_argv = argv;
fad_argc = argc;
usetmp = 0;
sprintf(tempfile,"%s%d",TMP,getpid());
sprintf(cat,"cat >%s",tempfile);
i=1;
while (i<argc)
{ comm = argv[i];
/* -adapt is default when using filenames as argument*/
if ('-' != comm[0])
{
comm = "-adapt";
usetmp++;
if (usetmp<USETMP) filename = argv[i];
else filename = tempfile;
if (access(argv[i],R_OK) != 0)
{
fprintf(stderr,"No access on %s!\n",argv[i]);
exit(-1);
}
else
{
if (is_source_file(argv[i],strlen(argv[i])) == false)
{
fprintf(stderr,"No Fortran filename\n");
exit(-1);
}
strcpy(cat+strlen(cat)-strlen(tempfile)-1,argv[i]);
strcpy(cat+strlen(cat)," >");
strcpy(cat+strlen(cat),tempfile);
}
}
/* end of -adapt is default when using filenames as argument */
if (strcmp(comm,"-parse") == 0)
{ command = 1;
}
else if (strcmp(comm,"-semantic") == 0)
{ command = 2;
}
else if (strcmp(comm,"-call") == 0)
{ command = 3;
}
else if (strcmp(comm,"-adapt") == 0)
{ command = 4;
}
else if (strcmp(comm,"-p") == 0)
{
if ((argc >= (i+1)) && (sscanf (argv[i+1], "%d", &MinProc)))
i++;
else
{
fprintf(stderr,"argument missing or argument type wrong\n");
fprintf(stderr,"needed for argument -p\n");
exit(-1);
}
}
else if (strcmp(comm,"-F90") == 0)
target_language = FORTRAN_90;
else if (strcmp(comm,"-F77") == 0)
target_language = FORTRAN_77;
else if (strcmp(comm,"-S") == 0)
{ array_kind = STATIC_ARRAYS;
if ((argc > (i+1)) &&
(sscanf (argv[i+1], "%d", &StaticArraySize)))
i++;
else
{
fprintf(stderr,"argument missing or argument type wrong\n");
fprintf(stderr,"needed for argument -S\n");
exit(-1);
}
}
else if (strcmp(comm,"-D") == 0)
array_kind = DYNAMIC_ARRAYS;
else if (strcmp(comm,"-sun") == 0)
target_machine = SUN4_PVM;
else if (strcmp(comm,"-os2pvm") == 0)
target_machine = OS2_PVM;
else if (strcmp(comm,"-ibm") == 0)
target_machine = RIOS_PVM;
else if (strcmp(comm,"-alliant") == 0)
target_machine = ALLIANT;
else if (strcmp(comm,"-all_pvm") == 0)
target_machine = ALL_PVM;
else if (strcmp(comm,"-ipsc") == 0)
target_machine = IPSC_860;
else if (strcmp(comm,"-gc") == 0)
target_machine = PARSYTEC_GC;
else if (strcmp(comm,"-meiko_cs1") == 0)
target_machine = MEIKO_CS1;
else if (strcmp(comm,"-meiko_cs2") == 0)
target_machine = MEIKO_CS2;
else if (strcmp(comm,"-ksr1") == 0)
target_machine = KSR1;
else if (strcmp(comm,"-ksr") == 0)
target_machine = KSR1;
else if (strcmp(comm,"-ksr1_pvm") == 0)
target_machine = KSR1_PVM;
else if (strcmp(comm,"-ksr_pvm") == 0)
target_machine = KSR1_PVM;
else if (strcmp(comm,"-cm5") == 0)
target_machine = CM5;
else if (strcmp(comm,"-cm") == 0)
target_machine = CM5;
else if (strcmp(comm,"-sgi") == 0)
target_machine = SGI;
else if (strcmp(comm,"-1") == 0)
target_model = UNI_PROC;
else if (strcmp(comm,"-uniproc") == 0)
target_model = UNI_PROC;
else if (strcmp(comm,"-split") == 0)
split_flag = 1;
else if (strcmp(comm,"-nosplit") == 0)
split_flag = 0;
else if (strcmp(comm,"-ddr") == 0)
ddefault_kind = DDEFAULT_REPLICATED;
else if (strcmp(comm,"-ddb") == 0)
ddefault_kind = DDEFAULT_DISTRIBUTED;
else if (strcmp(comm,"-ddcm") == 0)
ddefault_kind = DDEFAULT_CM;
else if (strcmp(comm,"-N") == 0)
target_model = ONLY_NODE;
else if (strcmp(comm,"-H") == 0)
target_model = HOST_NODE;
else if (strcmp(comm,"-home") == 0)
{
if ((argc > (i+1)) && (sscanf (argv[i+1], "%s", PHOME)))
i++;
else
{
fprintf(stderr,"argument missing or argument type wrong\n");
fprintf(stderr,"needed for argument -home\n");
exit(-1);
}
}
else if (strcmp(comm,"-help") == 0)
{ print_help ();
exit (0);
}
else if (strcmp(comm,"-defaults") == 0)
{ print_defaults ();
exit (0);
}
else
{ printf (" fadapt -help\n");
printf (" fadapt -defaults\n");
exit (-1);
}
i++;
}
if (!check_options())
{
exit(-1);
}
if (usetmp>=USETMP) system(cat);
}
void print_help ()
{
printf ("\n");
printf ("fadapt\n");
printf (" [-home <dir> ] Home Directory\n");
printf (" [-sun] target machine = SUN4, PVM\n");
printf (" [-sgipvm] target machine = SGI, PVM\n");
printf (" [-ibm] target machine = IBM, PVM\n");
printf (" [-alliant] target machine = Alliant FX/2800\n");
printf (" [-all_pvm] target machine = Alliant FX/2800 with PVM\n");
printf (" [-ipsc] target machine = iPSC/860\n");
printf (" [-gc] target machine = Parsytec GC\n");
printf (" [-meiko_cs1] target machine = Meiko CS 1\n");
printf (" [-meiko_cs2] target machine = Meiko CS 2\n");
printf (" [-ksr] target machine = KSR 1\n");
printf (" [-ksr_pvm] target machine = KSR 1 with PVM\n");
printf (" [-sgi] target machine = Silicon Graphics (IRIX)\n");
printf (" [-cm] target machine = CM 5\n");
printf (" \n");
printf (" [-H | -N | -1] model = HOST_NODE, ONLY_NODE, UNI_PROC\n");
printf (" [-uniproc] model = UNI_PROC, same as -1\n");
printf (" [-p <n>] Minimal number of processes\n");
printf (" [-F90|-F77] Target Language (Fortran 77 or Fortran 90\n");
printf (" [-S size|-D] Distributed/Dynamic arrays static or dynamic\n");
printf (" [-split|-nosplit] Split up generated sources\n");
printf (" [-ddr|-ddb|-ddcm] Default Distribution replicated/block/CM\n");
printf ("\n");
printf (" ( -parse | -semantic | -call | -adapt ) filename\n");
printf ("\n");
} /* print_help */
void print_defaults ()
{ printf ("\n");
printf ("Defaults of fadapt:\n");
printf ("===================\n");
printf ("\n");
printf ("Home Directory : %s\n", PHOME);
printf ("Default Distribution : ");
if (ddefault_kind == DDEFAULT_REPLICATED) printf ("replicated (ddr)\n");
if (ddefault_kind == DDEFAULT_DISTRIBUTED)
printf ("arrays are block distributed (ddb)\n");
if (ddefault_kind == DDEFAULT_CM) printf ("like CM (ddcm)\n");
printf ("Target Machine : ");
if (target_machine == ALLIANT) printf ("alliant (Alliant FX/2800)");
if (target_machine == ALL_PVM) printf ("all_pvm (Alliant FX/2800, PVM)");
if (target_machine == SUN4_PVM) printf ("sun (SUN4, PVM)");
if (target_machine == OS2_PVM) printf ("os2pvm (OS2, PVM)");
if (target_machine == RIOS_PVM) printf ("ibm (IBM RISC, PVM)");
if (target_machine == IPSC_860) printf ("ipsc (iPSC/860)");
if (target_machine == PARSYTEC_GC) printf ("gc (Parsytec GCel)");
if (target_machine == MEIKO_CS1) printf ("meiko_cs1 (Meiko CS1)");
if (target_machine == MEIKO_CS2) printf ("meiko_cs2 (Meiko CS2)");
if (target_machine == CM5) printf ("Connection Machine 5");
if (target_machine == KSR1) printf ("Kendall Square Research 1");
if (target_machine == SGI) printf ("sgi (Silicon Graphics)");
printf ("\n");
printf ("Target Model : ");
if (target_model == UNI_PROC) printf("One Processor");
if (target_model == ONLY_NODE) printf("N=Only Nodes");
if (target_model == HOST_NODE) printf("H=Host+Nodes");
printf ("\n");
printf ("Target Language : ");
if (target_language == FORTRAN_77) printf("F77 (Fortran 77)");
if (target_language == FORTRAN_90) printf("F90 (Fortran 90)");
printf ("\n\n");
printf ("Distributed/Dynamic Arrays will be : ");
if (array_kind == STATIC_ARRAYS)
printf("S=static with minimal size = %d", StaticArraySize);
if (array_kind == DYNAMIC_ARRAYS) printf("D=dynamic");
printf ("\n");
printf ("Minimal number of processes (p) : %d\n", MinProc);
printf ("\n");
if (split_flag)
printf ("Generated sources will be split (split)\n");
else
printf ("Generated sources will not be split (nosplit)\n");
printf ("\n");
} /* print_defaults */
main(argc, argv)
int argc;
char **argv;
{ int ErrorCount;
eval_arg (argc, argv);
if (command == 0)
#ifdef BATCH
{ printf ("Only Batch version\n");
exit(-1);
}
#else
{ interactive = 1;
xmenu (argc, argv); /* widget management */
}
#endif
else
{ printf ("Command = %d, FileName : %s\n", command, filename);
ErrorCount = SourceParser (filename);
printf ("%s\n", last_message);
if (ErrorCount > 0)
exit (-1);
if (command > 1)
{ ErrorCount = SourceSemantic ();
printf ("%s\n", last_message);
if (ErrorCount > 0) exit (-1);
}
/* SourceWrite (); */
if (command == 3) SourceCalling ();
/* SourceCheck (); */
if (command == 4) SourceAdapt ();
}
if (usetmp>=USETMP)
{
char remove[MAXCOMMANDLINELENGTH];
sprintf(remove,"rm -f %s",tempfile);
system(remove);
}
exit (0);
}